#!/usr/bin/env perl

use utf8;
use v5.10;
use strict;
use warnings;

use Encode;
use File::Spec;
use XML::LibXML;
use URI::Escape;
use HTML::Strip;
use HTML::Entities;
use Text::Unidecode;
use List::Util qw(max);

use constant XML_TEI_NS      => 'http://www.tei-c.org/ns/1.0';
use constant TEI_HEADER_FILE => 'head.xml';

my $input      = shift or die 'Text file not specified';
my $output_dir = shift or die 'Output directory not specified';

open my $fh, '<:encoding(UTF-8)', $input or die "$input: $!";
chomp(my $page_title = <$fh>);
my $raw = do { local $/; <$fh> };
close $fh;

my $greeting = do { local $/; <DATA> };

my $unidecoded     = unidecode($page_title);
my $discussion_dir = $unidecoded;
$discussion_dir =~ s<[^a-zA-Z0-9_-]><_>g;
$output_dir = File::Spec->catdir($output_dir, $discussion_dir);
mkdir $output_dir, 0755 or die "$output_dir: $!";

# get conversations
my @conversations = grep length,
                    split /(?:\r?\n){2,}/,
                    $raw;

$conversations[0] =~ s<^ :+ \s*><>x; # fixup incorrect markup

for(@conversations) {
    # remove wiki markup
    s<(?: ={2,3} | {{ ) .+? (?: ={2,3} | }} )><>gx;
    s<^ (\*{2,})><':' x length $1>gmxe;
    s<^ \* (:+)><$1>gmx;
    s<^ (:+) \*+><$1>gmx;
    s<\Q[[\E ( [^[]*? ) (?: \| ( [^[]*? ) )? \Q]]\E><$2 || $1>gxe;
    s<('{2,}) ( [^']+? ) \1><$2>gx;

    # remove standard greeting
    s<\Q$greeting><>;
}

# filter out leftovers
@conversations = grep /\p{Letter}/, @conversations;

# fixup nested conversations
my $ctr = 0;
while(grep /^:/, @conversations) {
    my %merged;
    for my $i (0 .. $#conversations-1) {
        my $j = $i + 1;
        if($conversations[$j] =~ /^:/) {
            $conversations[$i] = join "\n", $conversations[$i], $conversations[$j];
            $merged{$j} = 1;
        }
    }

    @conversations = @conversations[grep !$merged{$_}, 0 .. $#conversations];

    if($ctr++ > 1000) {
        warn "Possible incorrect markup in file $input, skipping";
        exit;
    }
}

# split fixed conversations
@conversations = grep /\p{Letter}/,
                 map split(/^ \* \s*/mx),
                 @conversations;

{
    my $xml = XML::LibXML::Document->new('1.0', 'utf-8');

    my $tei_header = _e('teiHeader', $xml);
    _a($tei_header, 'type', 'text');

    my $file_desc = _e('fileDesc', $tei_header);

    my $title_stmt = _e('titleStmt', $file_desc);

    my $title = _e('title', $title_stmt);
    $title->appendText($page_title);
    _xa($title, 'id', $unidecoded);
    _xa($title, 'lang', 'ru');

    my $fn = File::Spec->catfile($output_dir, TEI_HEADER_FILE);
    $xml->toFile($fn, 2);
}

my $conversation_ctr = 1;
for(@conversations) {
    my $xml = XML::LibXML::Document->new('1.0', 'utf-8');

    my $tei_corpus = _e('teiCorpus', $xml);
    $tei_corpus->setNamespace(XML_TEI_NS, '', 0);

    my $include = _e('include', $tei_corpus);
    _a($include, 'href', TEI_HEADER_FILE);
    $include->setNamespace('', 'xi', 1);

    my $TEI = _e('TEI', $tei_corpus);
    $TEI->setNamespace(XML_TEI_NS, '', 0);

    my $tei_header = _e('teiHeader', $TEI);
    _a($tei_header, 'type', 'text');

    my $text = _e('text', $TEI);
    _xa($text, 'id', 'discussion');
    _xa($text, 'lang', 'ru');

    my $body = _e('body', $text);

    my @phrases = map {
        /^(:+)/;
        my $level = length($1 // ':');
        s<^ :+ \s*><>x;
        length() ? [$level, $_] : ();
    } split /\n/;

    my $phrase_ctr  = 1;
    my %level_start = (
        1 => $phrase_ctr,
    );

    for(@phrases) {
        # work around HTML::Strip UTF-8 bug
        state $strip = HTML::Strip->new(decode_entities => 0);
        $_->[1] = decode_entities(decode('utf-8', $strip->parse(encode('utf-8', $_->[1]))));
        $strip->eof;

        $_->[1] =~ m#
            (?:
                (?: -- | — | (?<!http:)\/\/ | \\ ) \s* |
                \. \s*
            )?
            ( .+? ) \s+
            ( [0-9]{2}:[0-9]{2} ) , \s+
            (
                [0-9]{1,2} \s+
                .+? \s+
                [0-9]{4} \s+
                \( [^)]+ \)
            )
            \z
        #x;

        my $author = $1 // 'N/A';
        my $time   = $2 // 'N/A';
        my $date   = $3 // 'N/A';

        for($_->[1]) {
            s<><>; # remove last match
            s<\s+$><>;
        }

        my $div = _e('div', $body);
        _xa($div, 'id', $phrase_ctr == 1 ? 'main_stm' : "${phrase_ctr}_phr");
        $div->appendTextChild('text', $_->[1]);

        my $closer = _e('closer', $div);
        $closer->appendTextChild('salute', $author);

        my $date_line = _e('dateLine', $div);
        $date_line->appendTextChild('time', $time);
        $date_line->appendTextChild('date', $date);

        my $reply_id = $level_start{$_->[0]} // max values %level_start;
        $level_start{$_->[0]+1} = $phrase_ctr++;

        unless($reply_id == 1) {
            my $prt   = _e('prt', $div);
            _a($prt, 'target', $_->[0] == 1 ? '#main_stm' : "#${reply_id}_phr");
        }
    }

    my $fn = File::Spec->catfile($output_dir, "$conversation_ctr.xml");
    $xml->toFile($fn, 2);
    $conversation_ctr++;
}

sub _e {
    my $e = XML::LibXML::Element->new(shift);
    if(@_) {
        my $parent = shift;
        if($parent->isa('XML::LibXML::Document')) {
            $parent->setDocumentElement($e);
        }
        else {
            $parent->appendChild($e);
        }
    }

    $e;
}

sub _a {
    shift->setAttribute(@_);
}

sub _xa {
    shift->setAttributeNS(XML_XML_NS, @_);
}

__DATA__
== Добро пожаловать ==
Здравствуйте, и добро пожаловать в русскоязычную часть Википедии. Спасибо за Ваш вклад в её улучшение. Надеюсь, что Вам здесь понравится, и Вы продолжите работу над этим проектом. Ниже приведены некоторые полезные для новичков ссылки:
*[[Википедия:Правила и указания]]
*[[Википедия:Как править статьи]]
*[[Википедия:Первые шаги]]
*[[Википедия:Изображения]]
*[[Википедия:Именование статей]]
Надеюсь, Вам доставит удовольствие участие в нашем общем проекте!
Кстати, Вы можете подписываться на страницах обсуждения, используя четыре подряд идущих знака тильды (<span>~~</span><span>~~</span>). Если у Вас возникли вопросы о проекте, воспользуйтесь [[:Category:Википедия:Справка|системой помощи]]. Если Вы не нашли в ней ответа на ваш вопрос, задайте его на [[Википедия:Форум|форуме]] проекта. Ещё раз, добро пожаловать :) !
